home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXDBCOMB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  16.8 KB  |  627 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RxDBComb;
  13.  
  14. {$I RX.INC}
  15.  
  16. interface
  17.  
  18. uses Windows, DbCtrls, VDBConsts,
  19.   Messages, Menus, Graphics, Classes, Controls, DB, 
  20.   {$IFNDEF RX_D3} DBTables, {$ENDIF} StdCtrls, DBConsts;
  21.  
  22. type
  23.  
  24. { TCustomDBComboBox }
  25.  
  26.   TCustomDBComboBox = class(TCustomComboBox)
  27.   private
  28.     FDataLink: TFieldDataLink;
  29. {$IFDEF WIN32}
  30.     FPaintControl: TPaintControl;
  31. {$ENDIF}
  32.     procedure DataChange(Sender: TObject);
  33.     procedure EditingChange(Sender: TObject);
  34.     function GetDataField: string;
  35.     function GetDataSource: TDataSource;
  36.     function GetField: TField;
  37.     function GetReadOnly: Boolean;
  38.     procedure SetDataField(const Value: string);
  39.     procedure SetDataSource(Value: TDataSource);
  40.     procedure SetEditReadOnly;
  41.     procedure SetReadOnly(Value: Boolean);
  42.     procedure UpdateData(Sender: TObject);
  43.     function GetComboText: string; virtual;
  44.     procedure SetComboText(const Value: string); virtual;
  45.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  46. {$IFDEF WIN32}
  47.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  48.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  49. {$ELSE}
  50.     function GetStyle: TComboBoxStyle;
  51. {$ENDIF}
  52.   protected
  53.     procedure SetItems(const Value: TStrings); override;
  54.     procedure Change; override;
  55.     procedure Click; override;
  56.     procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  57.       ComboProc: Pointer); override;
  58.     procedure CreateWnd; override;
  59.     procedure DropDown; override;
  60.     function GetPaintText: string; virtual;
  61.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  62.     procedure KeyPress(var Key: Char); override;
  63.     procedure Loaded; override;
  64.     procedure Notification(AComponent: TComponent;
  65.       Operation: TOperation); override;
  66.     procedure SetStyle(Value: TComboBoxStyle); {$IFDEF WIN32} override {$ELSE} virtual {$ENDIF};
  67.     procedure WndProc(var Message: TMessage); override;
  68.     property ComboText: string read GetComboText write SetComboText;
  69. {$IFNDEF WIN32}
  70.     property Style: TComboBoxStyle read GetStyle write SetStyle default csDropDown;
  71. {$ENDIF WIN32}
  72.     property DataField: string read GetDataField write SetDataField;
  73.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  74.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  75.   public
  76.     constructor Create(AOwner: TComponent); override;
  77.     destructor Destroy; override;
  78. {$IFDEF RX_D4}
  79.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  80.     function UpdateAction(Action: TBasicAction): Boolean; override;
  81.     function UseRightToLeftAlignment: Boolean; override;
  82. {$ENDIF}
  83.     property Field: TField read GetField;
  84.     property Items write SetItems;
  85.     property Text;
  86.   end;
  87.  
  88. { TRxDBComboBox }
  89.  
  90.   TRxDBComboBox = class(TCustomDBComboBox)
  91.   private
  92.     FValues: TStrings;
  93.     FEnableValues: Boolean;
  94.     procedure SetEnableValues(Value: Boolean);
  95.     procedure SetValues(Value: TStrings);
  96.     procedure ValuesChanged(Sender: TObject);
  97.   protected
  98.     procedure SetStyle(Value: TComboBoxStyle); override;
  99.     function GetComboText: string; override;
  100.     function GetPaintText: string; override;
  101.     procedure SetComboText(const Value: string); override;
  102.   public
  103.     constructor Create(AOwner: TComponent); override;
  104.     destructor Destroy; override;
  105.   published
  106.     property Style; { must be published before Items }
  107.     property Color;
  108.     property Ctl3D;
  109.     property DataField;
  110.     property DataSource;
  111.     property DragMode;
  112.     property DragCursor;
  113.     property DropDownCount;
  114.     property Enabled;
  115.     property EnableValues: Boolean read FEnableValues write SetEnableValues;
  116.     property Font;
  117. {$IFDEF RX_D4}
  118.     property Anchors;
  119.     property BiDiMode;
  120.     property Constraints;
  121.     property DragKind;
  122.     property ParentBiDiMode;
  123. {$ENDIF}
  124. {$IFDEF WIN32}
  125.   {$IFNDEF VER90}
  126.     property ImeMode;
  127.     property ImeName;
  128.   {$ENDIF}
  129. {$ENDIF}
  130.     property ItemHeight;
  131.     property Items;
  132.     property ParentColor;
  133.     property ParentCtl3D;
  134.     property ParentFont;
  135.     property ParentShowHint;
  136.     property PopupMenu;
  137.     property ReadOnly;
  138.     property ShowHint;
  139.     property Sorted;
  140.     property TabOrder;
  141.     property TabStop;
  142.     property Values: TStrings read FValues write SetValues;
  143.     property Visible;
  144.     property OnChange;
  145.     property OnClick;
  146.     property OnDblClick;
  147.     property OnDragDrop;
  148.     property OnDragOver;
  149.     property OnDrawItem;
  150.     property OnDropDown;
  151.     property OnEndDrag;
  152.     property OnEnter;
  153.     property OnExit;
  154.     property OnKeyDown;
  155.     property OnKeyPress;
  156.     property OnKeyUp;
  157.     property OnMeasureItem;
  158. {$IFDEF WIN32}
  159.     property OnStartDrag;
  160. {$ENDIF}
  161. {$IFDEF RX_D5}
  162.     property OnContextPopup;
  163. {$ENDIF}
  164. {$IFDEF RX_D4}
  165.     property OnEndDock;
  166.     property OnStartDock;
  167. {$ENDIF}
  168.   end;
  169.  
  170. implementation
  171.  
  172. uses DBUtils;
  173.  
  174. { TCustomDBComboBox }
  175.  
  176. constructor TCustomDBComboBox.Create(AOwner: TComponent);
  177. begin
  178.   inherited Create(AOwner);
  179. {$IFDEF WIN32}
  180.   ControlStyle := ControlStyle + [csReplicatable];
  181. {$ENDIF}
  182.   FDataLink := TFieldDataLink.Create;
  183.   FDataLink.Control := Self;
  184.   FDataLink.OnDataChange := DataChange;
  185.   FDataLink.OnUpdateData := UpdateData;
  186.   FDataLink.OnEditingChange := EditingChange;
  187. {$IFDEF WIN32}
  188.   FPaintControl := TPaintControl.Create(Self, 'COMBOBOX');
  189. {$ENDIF}
  190. end;
  191.  
  192. destructor TCustomDBComboBox.Destroy;
  193. begin
  194. {$IFDEF WIN32}
  195.   FPaintControl.Free;
  196. {$ENDIF}
  197.   FDataLink.OnDataChange := nil;
  198.   FDataLink.OnUpdateData := nil;
  199.   FDataLink.Free;
  200.   FDataLink := nil;
  201.   inherited Destroy;
  202. end;
  203.  
  204. procedure TCustomDBComboBox.Loaded;
  205. begin
  206.   inherited Loaded;
  207.   if (csDesigning in ComponentState) then DataChange(Self);
  208. end;
  209.  
  210. procedure TCustomDBComboBox.Notification(AComponent: TComponent;
  211.   Operation: TOperation);
  212. begin
  213.   inherited Notification(AComponent, Operation);
  214.   if (Operation = opRemove) and (FDataLink <> nil) and
  215.     (AComponent = DataSource) then DataSource := nil;
  216. end;
  217.  
  218. procedure TCustomDBComboBox.CreateWnd;
  219. begin
  220.   inherited CreateWnd;
  221.   SetEditReadOnly;
  222. end;
  223.  
  224. procedure TCustomDBComboBox.DataChange(Sender: TObject);
  225. begin
  226.   if DroppedDown then Exit;
  227.   if FDataLink.Field <> nil then ComboText := FDataLink.Field.Text
  228.   else if csDesigning in ComponentState then ComboText := Name
  229.   else ComboText := '';
  230. end;
  231.  
  232. procedure TCustomDBComboBox.UpdateData(Sender: TObject);
  233. begin
  234.   FDataLink.Field.Text := ComboText;
  235. end;
  236.  
  237. procedure TCustomDBComboBox.SetComboText(const Value: string);
  238. var
  239.   I: Integer;
  240.   Redraw: Boolean;
  241. begin
  242.   if Value <> ComboText then begin
  243.     if Style <> csDropDown then begin
  244.       Redraw := (Style <> csSimple) and HandleAllocated;
  245.       if Redraw then SendMessage(Handle, WM_SETREDRAW, 0, 0);
  246.       try
  247.         if Value = '' then I := -1 else I := Items.IndexOf(Value);
  248.         ItemIndex := I;
  249.       finally
  250.         if Redraw then begin
  251.           SendMessage(Handle, WM_SETREDRAW, 1, 0);
  252.           Invalidate;
  253.         end;
  254.       end;
  255.       if I >= 0 then Exit;
  256.     end;
  257.     if Style in [csDropDown, csSimple] then Text := Value;
  258.   end;
  259. end;
  260.  
  261. function TCustomDBComboBox.GetComboText: string;
  262. var
  263.   I: Integer;
  264. begin
  265.   if Style in [csDropDown, csSimple] then Result := Text
  266.   else begin
  267.     I := ItemIndex;
  268.     if I < 0 then Result := '' else Result := Items[I];
  269.   end;
  270. end;
  271.  
  272. procedure TCustomDBComboBox.Change;
  273. begin
  274.   FDataLink.Edit;
  275.   inherited Change;
  276.   FDataLink.Modified;
  277. end;
  278.  
  279. procedure TCustomDBComboBox.Click;
  280. begin
  281.   FDataLink.Edit;
  282.   inherited Click;
  283.   FDataLink.Modified;
  284. end;
  285.  
  286. procedure TCustomDBComboBox.DropDown;
  287. begin
  288. {$IFNDEF WIN32}
  289.   FDataLink.Edit;
  290. {$ENDIF}
  291.   inherited DropDown;
  292. end;
  293.  
  294. function TCustomDBComboBox.GetDataSource: TDataSource;
  295. begin
  296.   Result := FDataLink.DataSource;
  297. end;
  298.  
  299. procedure TCustomDBComboBox.SetDataSource(Value: TDataSource);
  300. begin
  301. {$IFDEF RX_D4}
  302.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  303. {$ENDIF}
  304.     FDataLink.DataSource := Value;
  305. {$IFDEF WIN32}
  306.   if Value <> nil then Value.FreeNotification(Self);
  307. {$ENDIF}
  308. end;
  309.  
  310. function TCustomDBComboBox.GetDataField: string;
  311. begin
  312.   Result := FDataLink.FieldName;
  313. end;
  314.  
  315. procedure TCustomDBComboBox.SetDataField(const Value: string);
  316. begin
  317.   FDataLink.FieldName := Value;
  318. end;
  319.  
  320. function TCustomDBComboBox.GetReadOnly: Boolean;
  321. begin
  322.   Result := FDataLink.ReadOnly;
  323. end;
  324.  
  325. procedure TCustomDBComboBox.SetReadOnly(Value: Boolean);
  326. begin
  327.   FDataLink.ReadOnly := Value;
  328. end;
  329.  
  330. function TCustomDBComboBox.GetField: TField;
  331. begin
  332.   Result := FDataLink.Field;
  333. end;
  334.  
  335. procedure TCustomDBComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  336. begin
  337.   inherited KeyDown(Key, Shift);
  338.   if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then begin
  339.     if not FDataLink.Edit and (Key in [VK_UP, VK_DOWN]) then
  340.       Key := 0;
  341.   end;
  342. end;
  343.  
  344. procedure TCustomDBComboBox.KeyPress(var Key: Char);
  345. begin
  346.   inherited KeyPress(Key);
  347.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  348.     not FDataLink.Field.IsValidChar(Key) then
  349.   begin
  350.     MessageBeep(0);
  351.     Key := #0;
  352.   end;
  353.   case Key of
  354.     ^H, ^V, ^X, #32..#255:
  355.       FDataLink.Edit;
  356.     #27:
  357.       begin
  358.         FDataLink.Reset;
  359.         SelectAll;
  360. {$IFNDEF WIN32}
  361.         Key := #0;
  362. {$ENDIF}
  363.       end;
  364.   end;
  365. end;
  366.  
  367. procedure TCustomDBComboBox.EditingChange(Sender: TObject);
  368. begin
  369.   SetEditReadOnly;
  370. end;
  371.  
  372. procedure TCustomDBComboBox.SetEditReadOnly;
  373. begin
  374.   if (Style in [csDropDown, csSimple]) and HandleAllocated then
  375.     SendMessage({$IFDEF WIN32} EditHandle {$ELSE} FEditHandle {$ENDIF},
  376.       EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
  377. end;
  378.  
  379. procedure TCustomDBComboBox.WndProc(var Message: TMessage);
  380. begin
  381.   if not (csDesigning in ComponentState) then
  382.     case Message.Msg of
  383.       WM_COMMAND:
  384.         if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then
  385.           if not FDataLink.Edit then begin
  386.             if Style <> csSimple then
  387.               PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
  388.             Exit;
  389.           end;
  390.       CB_SHOWDROPDOWN:
  391.         if Message.WParam <> 0 then FDataLink.Edit
  392.         else if not FDataLink.Editing then DataChange(Self); {Restore text}
  393. {$IFDEF WIN32}
  394.       WM_CREATE,
  395.       WM_WINDOWPOSCHANGED,
  396.       CM_FONTCHANGED:
  397.         FPaintControl.DestroyHandle;
  398. {$ENDIF}
  399.     end;
  400.   inherited WndProc(Message);
  401. end;
  402.  
  403. procedure TCustomDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  404.   ComboProc: Pointer);
  405. begin
  406.   if not (csDesigning in ComponentState) then
  407.     case Message.Msg of
  408.       WM_LBUTTONDOWN:
  409. {$IFDEF WIN32}
  410.         if (Style = csSimple) and (ComboWnd <> EditHandle) then
  411. {$ELSE}
  412.         if (Style = csSimple) and (ComboWnd <> FEditHandle) then
  413. {$ENDIF}
  414.           if not FDataLink.Edit then Exit;
  415.     end;
  416.   inherited ComboWndProc(Message, ComboWnd, ComboProc);
  417. end;
  418.  
  419. procedure TCustomDBComboBox.CMExit(var Message: TCMExit);
  420. begin
  421.   try
  422.     FDataLink.UpdateRecord;
  423.   except
  424.     SelectAll;
  425.     if CanFocus then SetFocus;
  426.     raise;
  427.   end;
  428.   inherited;
  429. end;
  430.  
  431. {$IFDEF WIN32}
  432. procedure TCustomDBComboBox.CMGetDatalink(var Message: TMessage);
  433. begin
  434.   Message.Result := Longint(FDataLink);
  435. end;
  436.  
  437. procedure TCustomDBComboBox.WMPaint(var Message: TWMPaint);
  438. var
  439.   S: string;
  440.   R: TRect;
  441.   P: TPoint;
  442.   Child: HWND;
  443. begin
  444.   if csPaintCopy in ControlState then begin
  445.     S := GetPaintText;
  446.     if Style = csDropDown then begin
  447.       SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Longint(PChar(S)));
  448.       SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
  449.       Child := GetWindow(FPaintControl.Handle, GW_CHILD);
  450.       if Child <> 0 then begin
  451.         Windows.GetClientRect(Child, R);
  452.         Windows.MapWindowPoints(Child, FPaintControl.Handle, R.TopLeft, 2);
  453.         GetWindowOrgEx(Message.DC, P);
  454.         SetWindowOrgEx(Message.DC, P.X - R.Left, P.Y - R.Top, nil);
  455.         IntersectClipRect(Message.DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top);
  456.         SendMessage(Child, WM_PAINT, Message.DC, 0);
  457.       end;
  458.     end
  459.     else begin
  460.       SendMessage(FPaintControl.Handle, CB_RESETCONTENT, 0, 0);
  461.       if Items.IndexOf(S) <> -1 then begin
  462.         SendMessage(FPaintControl.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
  463.         SendMessage(FPaintControl.Handle, CB_SETCURSEL, 0, 0);
  464.       end;
  465.       SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
  466.     end;
  467.   end
  468.   else inherited;
  469. end;
  470. {$ENDIF}
  471.  
  472. function TCustomDBComboBox.GetPaintText: string;
  473. begin
  474.   if FDataLink.Field <> nil then Result := FDataLink.Field.Text
  475.   else Result := '';
  476. end;
  477.  
  478. procedure TCustomDBComboBox.SetItems(const Value: TStrings);
  479. begin
  480.   inherited SetItems(Value);
  481.   //Items.Assign(Value);
  482.   DataChange(Self);
  483. end;
  484.  
  485. {$IFNDEF WIN32}
  486. function TCustomDBComboBox.GetStyle: TComboBoxStyle;
  487. begin
  488.   Result := inherited Style;
  489. end;
  490. {$ENDIF}
  491.  
  492. procedure TCustomDBComboBox.SetStyle(Value: TComboBoxStyle);
  493. begin
  494. {$IFDEF WIN32}
  495.   if (Value = csSimple) and Assigned(FDatalink) and FDatalink.DatasourceFixed then
  496.     _DBError(SNotReplicatable);
  497.   inherited SetStyle(Value);
  498. {$ELSE}
  499.   if Value = csSimple then ControlStyle := ControlStyle - [csFixedHeight]
  500.   else ControlStyle := ControlStyle + [csFixedHeight];
  501.   inherited Style := Value;
  502.   RecreateWnd;
  503. {$ENDIF}
  504. end;
  505.  
  506. {$IFDEF RX_D4}
  507. function TCustomDBComboBox.UseRightToLeftAlignment: Boolean;
  508. begin
  509.   Result := DBUseRightToLeftAlignment(Self, Field);
  510. end;
  511.  
  512. function TCustomDBComboBox.ExecuteAction(Action: TBasicAction): Boolean;
  513. begin
  514.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  515.     FDataLink.ExecuteAction(Action);
  516. end;
  517.  
  518. function TCustomDBComboBox.UpdateAction(Action: TBasicAction): Boolean;
  519. begin
  520.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  521.     FDataLink.UpdateAction(Action);
  522. end;
  523. {$ENDIF}
  524.  
  525. { TRxDBComboBox }
  526.  
  527. constructor TRxDBComboBox.Create(AOwner: TComponent);
  528. begin
  529.   inherited Create(AOwner);
  530.   FValues := TStringList.Create;
  531.   TStringList(FValues).OnChange := ValuesChanged;
  532.   EnableValues := False;
  533. end;
  534.  
  535. destructor TRxDBComboBox.Destroy;
  536. begin
  537.   TStringList(FValues).OnChange := nil;
  538.   FValues.Free;
  539.   inherited Destroy;
  540. end;
  541.  
  542. procedure TRxDBComboBox.ValuesChanged(Sender: TObject);
  543. begin
  544.   if FEnableValues then DataChange(Self);
  545. end;
  546.  
  547. function TRxDBComboBox.GetPaintText: string;
  548. var
  549.   I: Integer;
  550. begin
  551.   Result := '';
  552.   if FDataLink.Field <> nil then begin
  553.     if FEnableValues then begin
  554.       I := Values.IndexOf(FDataLink.Field.Text);
  555.       if I >= 0 then Result := Items.Strings[I]
  556.     end
  557.     else Result := FDataLink.Field.Text;
  558.   end;
  559. end;
  560.  
  561. function TRxDBComboBox.GetComboText: string;
  562. var
  563.   I: Integer;
  564. begin
  565.   if (Style in [csDropDown, csSimple]) and (not FEnableValues) then
  566.     Result := Text
  567.   else begin
  568.     I := ItemIndex;
  569.     if (I < 0) or (FEnableValues and (FValues.Count < I + 1)) then
  570.       Result := ''
  571.     else
  572.       if FEnableValues then Result := FValues[I]
  573.       else Result := Items[I];
  574.   end;
  575. end;
  576.  
  577. procedure TRxDBComboBox.SetComboText(const Value: string);
  578. var
  579.   I: Integer;
  580.   Redraw: Boolean;
  581. begin
  582.   if Value <> ComboText then begin
  583.     if Style <> csDropDown then begin
  584.       Redraw := (Style <> csSimple) and HandleAllocated;
  585.       if Redraw then SendMessage(Handle, WM_SETREDRAW, 0, 0);
  586.       try
  587.         if Value = '' then I := -1 else
  588.           if FEnableValues then I := Values.IndexOf(Value)
  589.           else I := Items.IndexOf(Value);
  590.         if I >= Items.Count then I := -1;
  591.         ItemIndex := I;
  592.       finally
  593.         if Redraw then begin
  594.           SendMessage(Handle, WM_SETREDRAW, 1, 0);
  595.           Invalidate;
  596.         end;
  597.       end;
  598.       if I >= 0 then Exit;
  599.     end;
  600.     if Style in [csDropDown, csSimple] then Text := Value;
  601.   end;
  602. end;
  603.  
  604. procedure TRxDBComboBox.SetEnableValues(Value: Boolean);
  605. begin
  606.   if FEnableValues <> Value then begin
  607.     if Value and (Style in [csDropDown, csSimple]) then
  608.       Style := csDropDownList;
  609.     FEnableValues := Value;
  610.     DataChange(Self);
  611.   end;
  612. end;
  613.  
  614. procedure TRxDBComboBox.SetValues(Value: TStrings);
  615. begin
  616.   FValues.Assign(Value);
  617. end;
  618.  
  619. procedure TRxDBComboBox.SetStyle(Value: TComboboxStyle);
  620. begin
  621.   if (Value in [csSimple, csDropDown]) and FEnableValues then
  622.     Value := csDropDownList;
  623.   inherited SetStyle(Value);
  624. end;
  625.  
  626. end.
  627.